home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / wmapdemo / data.z / MAPMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-17  |  21KB  |  691 lines
  1. unit Mapmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, WorldMap, StdCtrls, Buttons, ExtCtrls, DB, DBTables,
  8.   Menus,mapabout,Printers,adjgrid,viewer,setbmp;
  9.  
  10. type
  11.   mydata  = record
  12.     anInt : integer;
  13.     aString : string;
  14.   end;
  15.   Pmydata = ^mydata;
  16.   TMapForm = class(TForm)
  17.     Mapanel: TPanel;
  18.     Label1: TLabel;
  19.     Label3: TLabel;
  20.     labels: TSpeedButton;
  21.     SpeedButton2: TSpeedButton;
  22.     SpeedButton3: TSpeedButton;
  23.     points: TSpeedButton;
  24.     curlat: TEdit;
  25.     Curlong: TEdit;
  26.     LinesButton1: TSpeedButton;
  27.     SpeedButton1: TSpeedButton;
  28.     StateBtn: TSpeedButton;
  29.     LakeBtn: TSpeedButton;
  30.     RiversBtn: TSpeedButton;
  31.     Edit1: TEdit;
  32.     ZoomInBtn: TSpeedButton;
  33.     ZoomOutBtn: TSpeedButton;
  34.     MainMenu1: TMainMenu;
  35.     Zoom1: TMenuItem;
  36.     SetCoordinates1: TMenuItem;
  37.     DrawLine1: TMenuItem;
  38.     Full1: TMenuItem;
  39.     SetZoom1: TMenuItem;
  40.     N2: TMenuItem;
  41.     Print1: TMenuItem;
  42.     Point1: TMenuItem;
  43.     ShowPoints1: TMenuItem;
  44.     SHowLabels1: TMenuItem;
  45.     FindPoint1: TMenuItem;
  46.     AdjustGrid1: TMenuItem;
  47.     CenterMapAtCursor1: TMenuItem;
  48.     scale: TEdit;
  49.     Label2: TLabel;
  50.     ChangeMapDataFile1: TMenuItem;
  51.     OpenDialog1: TOpenDialog;
  52.     Lines1: TMenuItem;
  53.     PlotLine1: TMenuItem;
  54.     ClearLines1: TMenuItem;
  55.     WorldMap1: TWorldMap;
  56.     ClearPoints1: TMenuItem;
  57.     NatCapsQry: TQuery;
  58.     PlotNationalCapitals1: TMenuItem;
  59.     ClickQry: TQuery;
  60.     PrintFullPageMap1: TMenuItem;
  61.     CreateMapBMP1: TMenuItem;
  62.     ShowLines1: TMenuItem;
  63.     SaveDialog1: TSaveDialog;
  64.     ShowRedPoints: TMenuItem;
  65.     ShowYellowPoints1: TMenuItem;
  66.     ShowBluePoints1: TMenuItem;
  67.     ShowAllPoints1: TMenuItem;
  68.     procedure Full1Click(Sender: TObject);
  69.     procedure ShowPoints1Click(Sender: TObject);
  70.     procedure SHowLabels1Click(Sender: TObject);
  71.     procedure SetZoom1Click(Sender: TObject);
  72.     procedure SetCoordinates1Click(Sender: TObject);
  73.     procedure WorldMap1PointChange(Sender: TObject);
  74.     procedure WorldMap1PointClicked(Sender: TObject;
  75.       Curpoint: TPointObject; AIndex: Integer);
  76.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  77.     procedure DrawLine1Click(Sender: TObject);
  78.     procedure LinesButton1Click(Sender: TObject);
  79.     procedure FindPoint1Click(Sender: TObject);
  80.     procedure Contents1Click(Sender: TObject);
  81.     procedure TopicSearch1Click(Sender: TObject);
  82.     procedure Print1Click(Sender: TObject);
  83.     procedure About1Click(Sender: TObject);
  84.     procedure SpeedButton1Click(Sender: TObject);
  85.     procedure StateBtnClick(Sender: TObject);
  86.     procedure LakeBtnClick(Sender: TObject);
  87.     procedure RiversBtnClick(Sender: TObject);
  88.     procedure TurnOnFeature51Click(Sender: TObject);
  89.     procedure TurnOffFeature51Click(Sender: TObject);
  90.     procedure TurnOnFeature61Click(Sender: TObject);
  91.     procedure TurnOffFeature61Click(Sender: TObject);
  92.     procedure ZoomInBtnClick(Sender: TObject);
  93.     procedure FormCreate(Sender: TObject);
  94.     procedure WorldMap1MapMouseUp(Sender: TObject; Button: TMouseButton;
  95.       Shift: TShiftState; X, Y: Integer; Lat, Long: Longint);
  96.     procedure ZoomOutBtnClick(Sender: TObject);
  97.     procedure AdjustGrid1Click(Sender: TObject);
  98.     procedure CenterMapAtCursor1Click(Sender: TObject);
  99.     procedure WorldMap1Zoom(Sender: TObject);
  100.     procedure ChangeMapDataFile1Click(Sender: TObject);
  101.     procedure PlotLine1Click(Sender: TObject);
  102.     procedure WorldMap1MapMouseDown(Sender: TObject; Button: TMouseButton;
  103.       Shift: TShiftState; X, Y: Integer; Lat, Long: Longint);
  104.     procedure WorldMap1MapMouseMove(Sender: TObject; Shift: TShiftState; X,
  105.       Y: Integer; Lat, Long: Longint);
  106.     procedure ClearLines1Click(Sender: TObject);
  107.     procedure ClearPoints1Click(Sender: TObject);
  108.     procedure PlotNationalCapitals1Click(Sender: TObject);
  109.     procedure PrintFullPageMap1Click(Sender: TObject);
  110.     procedure CreateMapBMP1Click(Sender: TObject);
  111.     procedure ShowRedPointsClick(Sender: TObject);
  112.     function WorldMap1PointFilter(Sender: TObject;
  113.       Curpoint: TPointObject): Boolean;
  114.     procedure ShowYellowPoints1Click(Sender: TObject);
  115.     procedure ShowBluePoints1Click(Sender: TObject);
  116.     procedure ShowAllPoints1Click(Sender: TObject);
  117. private
  118.     { Private declarations }
  119.     Filtercolor : integer;
  120.   public
  121.     FZoomfactor : integer;
  122.     FZooming : boolean;
  123.     FPanning : boolean;
  124.     FSPt : Tpoint;
  125.     FEPt : Tpoint;
  126.     FbDrawingLine : boolean;
  127.     FbDrawingEnabled : boolean;
  128.     procedure DrawLine(X,Y : integer; IsFinal : boolean);
  129.     { Public declarations }
  130.   end;
  131.  
  132. const crHand = 6;
  133. const crPencil = 7;
  134. var
  135.   MapForm: TMapForm;
  136.  
  137. implementation
  138. uses pdialog,Ldialog,Findpt,main;
  139.  
  140. {$R *.DFM}
  141. {$R Worldmap.dcr}
  142. {$R Cursor.res}
  143.  
  144. procedure TMapForm.Full1Click(Sender: TObject);
  145. begin
  146.   Worldmap1.fullscreen;
  147. end;
  148.  
  149. procedure TMapForm.ShowPoints1Click(Sender: TObject);
  150. begin
  151.   if plotNationalCapitals1.enabled then begin
  152.     plotNationalCapitals1Click(Sender);
  153.   end else if Worldmap1.showpoints then begin
  154.     Worldmap1.ShowPoints := false;
  155.     Showpoints1.checked := false;
  156.   end else begin
  157.     Worldmap1.ShowPoints := true;
  158.     Showpoints1.checked := true;
  159.   end;
  160. end;
  161.  
  162. procedure TMapForm.SHowLabels1Click(Sender: TObject);
  163. begin
  164.   if Worldmap1.showpointlabels then begin
  165.     Worldmap1.showpointlabels := false;
  166.     ShowLabels1.checked := false;
  167.   end else begin
  168.     Worldmap1.showpointlabels := true;
  169.     ShowLabels1.checked := true;
  170.   end;
  171. end;
  172.  
  173. procedure TMapForm.SetZoom1Click(Sender: TObject);
  174. begin
  175.   Worldmap1.EnableZoom:= true;
  176. end;
  177.  
  178. procedure TMapForm.SetCoordinates1Click(Sender: TObject);
  179. begin
  180.   PointDlg := TPointDLg.Create(Application);
  181.   PointDlg.ShowModal;
  182. end;
  183.  
  184. procedure TMapForm.WorldMap1PointChange(Sender: TObject);
  185. begin
  186.   Curlat.text := Worldmap1.CurrentLatitudeStr;
  187.   Curlong.text := Worldmap1.CurrentLongitudestr;
  188. end;
  189.  
  190. procedure TMapForm.WorldMap1PointClicked(Sender: TObject;
  191.   Curpoint: TPointObject; AIndex: Integer);
  192. var
  193.   workstr : string;
  194.   i : integer;
  195.   cwd : string;
  196. begin
  197.    screen.cursor := crHourglass;
  198.    GetDir(0,cwd);
  199.    workstr:= 'Current Point ID is '+inttostr(Curpoint.tag)+#13;
  200.    Workstr:= workstr+Curpoint.labels.strings[0]+#13;
  201.    try
  202.      With Clickqry do begin
  203.        databasename := cwd;
  204.        params[0].AsInteger := Curpoint.tag;
  205.        prepare;
  206.        open;
  207.        Workstr := workstr+Fieldbyname('prov_name').Asstring+#13;
  208.        WorkStr := workstr+Fieldbyname('country_name').Asstring;
  209.      end;
  210.      screen.cursor := crDefault;
  211.      messagedlg(workstr,mtInformation,[mbOk],0);
  212.    finally
  213.      Clickqry.close;
  214.      ClickQry.database.close;
  215.      Screen.cursor := crDefault
  216.    end;
  217.   { worldmap1.HighlightPoint(Aindex); {Still testing this one}
  218. end;
  219.  
  220. procedure TMapForm.FormClose(Sender: TObject; var Action: TCloseAction);
  221. begin
  222.   Action := caFree;
  223. end;
  224.  
  225. procedure TMapForm.DrawLine1Click(Sender: TObject);
  226. begin
  227.   Worldmap1.hint := 'Click the left button where the lines will start, hold and drag the cursor to draw the line.';
  228.   Worldmap1.cursor := crPencil;
  229.   Worldmap1.EnablePointClick := false;
  230.   FbDrawingEnabled := true;
  231. end;
  232.  
  233. procedure TMapForm.LinesButton1Click(Sender: TObject);
  234. begin
  235.   if Worldmap1.Showlines then begin
  236.     WorldMap1.showlines := false;
  237.     ShowLines1.checked := false;
  238.   end else begin
  239.     WorldMap1.showlines := true;
  240.     ShowLines1.checked := true;
  241.   end;
  242. end;
  243.  
  244. procedure TMapForm.FindPoint1Click(Sender: TObject);
  245. begin
  246.   FindDlg := TFinddlg.Create(Application);
  247.   Finddlg.Showmodal;
  248. end;
  249.  
  250. procedure TMapForm.Contents1Click(Sender: TObject);
  251. begin
  252.  Application.helpjump('IDH_CONTENTS');
  253. end;
  254.  
  255. procedure TMapForm.TopicSearch1Click(Sender: TObject);
  256. const
  257.   EmptyString: PChar = '';
  258. begin
  259.   Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
  260. end;
  261.  
  262. procedure TMapForm.Print1Click(Sender: TObject);
  263.     var
  264.     xRect: TRect;
  265.         twidth : word;
  266.         offset : word;
  267. begin
  268. {  Worldmap1.printtofile := fal